home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio 2000
/
Ham Radio 2000.iso
/
ham2000
/
misc
/
dspice0s
/
swapij.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-11-21
|
12KB
|
426 lines
/* swapij.f -- translated by f2c (version of 3 February 1990 3:36:42).
You must link the resulting object file with the libraries:
-lF77 -lI77 -lm -lc (in that order)
*/
#include "f2c.h"
/* Common Block Declarations */
struct {
integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens,
nsens, ifour, nfour, ifield, icode, idelim, icolum, insize,
junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr,
numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap,
iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3,
lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod,
nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf,
irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar,
lvntmp;
} tabinf_;
#define tabinf_1 tabinf_
struct {
doublereal value[200000];
} blank_;
#define blank_1 blank_
/*< subroutine swapij(i1,i2,j1,j2) >*/
/* Subroutine */ int swapij_(i1, i2, j1, j2)
integer *i1, *i2, *j1, *j2;
{
/* System generated locals */
integer i_1;
/* Local variables */
static integer lsav1, lsav2, i, j, ktype;
#define nodplc ((integer *)&blank_1)
#define cvalue ((complex *)&blank_1)
static integer loc, loc1, loc2;
/*< implicit double precision (a-h,o-z) >*/
/* spice version 2g.6 sccsid=tabinf 3/15/83 */
/*< common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
/*< 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
/*< 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
/*< 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
/*< 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
/*< 5 imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
/*< 6 loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
/*< 7 irowno,jcolno,nttbr,nttar,lvntmp >*/
/* spice version 2g.6 sccsid=blank 3/15/83 */
/*< common /blank/ value(200000) >*/
/*< integer nodplc(64) >*/
/*< complex cvalue(32) >*/
/*< equivalence (value(1),nodplc(1),cvalue(1)) >*/
/* swap rows i1 and i2 */
/*< loc1=nodplc(jcpt+i1) >*/
loc1 = nodplc[tabinf_1.jcpt + *i1 - 1];
/*< loc2=nodplc(jcpt+i2) >*/
loc2 = nodplc[tabinf_1.jcpt + *i2 - 1];
/*< nodplc(jcpt+i1)=loc2 >*/
nodplc[tabinf_1.jcpt + *i1 - 1] = loc2;
/*< nodplc(jcpt+i2)=loc1 >*/
nodplc[tabinf_1.jcpt + *i2 - 1] = loc1;
/* check if end of row */
/*< 5 if (loc1.le.0.and.loc2.le.0) go to 80 >*/
L5:
if (loc1 <= 0 && loc2 <= 0) {
goto L80;
}
/* check swap type */
/*< if (loc1.eq.0) go to 20 >*/
if (loc1 == 0) {
goto L20;
}
/*< if (loc2.eq.0) go to 10 >*/
if (loc2 == 0) {
goto L10;
}
/*< if (nodplc(jcolno+loc1)-nodplc(jcolno+loc2)) 10,15,20 >*/
if ((i_1 = nodplc[tabinf_1.jcolno + loc1 - 1] - nodplc[tabinf_1.jcolno +
loc2 - 1]) < 0) {
goto L10;
} else if (i_1 == 0) {
goto L15;
} else {
goto L20;
}
/*< 10 ktype=-1 >*/
L10:
ktype = -1;
/*< j=nodplc(jcolno+loc1) >*/
j = nodplc[tabinf_1.jcolno + loc1 - 1];
/*< go to 25 >*/
goto L25;
/*< 15 ktype=0 >*/
L15:
ktype = 0;
/*< j=nodplc(jcolno+loc1) >*/
j = nodplc[tabinf_1.jcolno + loc1 - 1];
/*< go to 25 >*/
goto L25;
/*< 20 ktype=1 >*/
L20:
ktype = 1;
/*< j=nodplc(jcolno+loc2) >*/
j = nodplc[tabinf_1.jcolno + loc2 - 1];
/* find pointer to entry (i1,j) */
/*< 25 loc=j >*/
L25:
loc = j;
/*< 30 lsav1=loc >*/
L30:
lsav1 = loc;
/*< loc=nodplc(irpt+loc) >*/
loc = nodplc[tabinf_1.irpt + loc - 1];
/*< if (loc.eq.0) go to 40 >*/
if (loc == 0) {
goto L40;
}
/*< if ((nodplc(irowno+loc)-i1).lt.0) go to 30 >*/
if (nodplc[tabinf_1.irowno + loc - 1] - *i1 < 0) {
goto L30;
}
/* find pointer to entry (i2,j) */
/*< 40 loc=j >*/
L40:
loc = j;
/*< 45 lsav2=loc >*/
L45:
lsav2 = loc;
/*< loc=nodplc(irpt+loc) >*/
loc = nodplc[tabinf_1.irpt + loc - 1];
/*< if (loc.eq.0) go to 55 >*/
if (loc == 0) {
goto L55;
}
/*< if ((nodplc(irowno+loc)-i2).lt.0) go to 45 >*/
if (nodplc[tabinf_1.irowno + loc - 1] - *i2 < 0) {
goto L45;
}
/* branch for col j in row i1, in both row i1 and i2, or in row i2 */
/*< 55 if (ktype) 60,70,75 >*/
L55:
if (ktype < 0) {
goto L60;
} else if (ktype == 0) {
goto L70;
} else {
goto L75;
}
/* entry (i1,j) */
/*< 60 if (lsav1.eq.lsav2) go to 65 >*/
L60:
if (lsav1 == lsav2) {
goto L65;
}
/*< loc=nodplc(irpt+lsav2) >*/
loc = nodplc[tabinf_1.irpt + lsav2 - 1];
/*< nodplc(irpt+lsav2)=loc1 >*/
nodplc[tabinf_1.irpt + lsav2 - 1] = loc1;
/*< nodplc(irpt+lsav1)=nodplc(irpt+loc1) >*/
nodplc[tabinf_1.irpt + lsav1 - 1] = nodplc[tabinf_1.irpt + loc1 - 1];
/*< nodplc(irpt+loc1)=loc >*/
nodplc[tabinf_1.irpt + loc1 - 1] = loc;
/*< 65 nodplc(irowno+loc1)=i2 >*/
L65:
nodplc[tabinf_1.irowno + loc1 - 1] = *i2;
/*< loc1=nodplc(jcpt+loc1) >*/
loc1 = nodplc[tabinf_1.jcpt + loc1 - 1];
/*< go to 5 >*/
goto L5;
/* entries (i1,j) and (i2,j) */
/*< 70 nodplc(irpt+lsav1)=loc2 >*/
L70:
nodplc[tabinf_1.irpt + lsav1 - 1] = loc2;
/*< nodplc(irpt+lsav2)=loc1 >*/
nodplc[tabinf_1.irpt + lsav2 - 1] = loc1;
/*< loc=nodplc(irpt+loc1) >*/
loc = nodplc[tabinf_1.irpt + loc1 - 1];
/*< nodplc(irpt+loc1)=nodplc(irpt+loc2) >*/
nodplc[tabinf_1.irpt + loc1 - 1] = nodplc[tabinf_1.irpt + loc2 - 1];
/*< nodplc(irpt+loc2)=loc >*/
nodplc[tabinf_1.irpt + loc2 - 1] = loc;
/*< nodplc(irowno+loc1)=i2 >*/
nodplc[tabinf_1.irowno + loc1 - 1] = *i2;
/*< nodplc(irowno+loc2)=i1 >*/
nodplc[tabinf_1.irowno + loc2 - 1] = *i1;
/*< loc1=nodplc(jcpt+loc1) >*/
loc1 = nodplc[tabinf_1.jcpt + loc1 - 1];
/*< loc2=nodplc(jcpt+loc2) >*/
loc2 = nodplc[tabinf_1.jcpt + loc2 - 1];
/*< go to 5 >*/
goto L5;
/* entry (i2,j) */
/*< 75 if (lsav1.eq.lsav2) go to 78 >*/
L75:
if (lsav1 == lsav2) {
goto L78;
}
/*< loc=nodplc(irpt+lsav1) >*/
loc = nodplc[tabinf_1.irpt + lsav1 - 1];
/*< nodplc(irpt+lsav1)=loc2 >*/
nodplc[tabinf_1.irpt + lsav1 - 1] = loc2;
/*< nodplc(irpt+lsav2)=nodplc(irpt+loc2) >*/
nodplc[tabinf_1.irpt + lsav2 - 1] = nodplc[tabinf_1.irpt + loc2 - 1];
/*< nodplc(irpt+loc2)=loc >*/
nodplc[tabinf_1.irpt + loc2 - 1] = loc;
/*< 78 nodplc(irowno+loc2)=i1 >*/
L78:
nodplc[tabinf_1.irowno + loc2 - 1] = *i1;
/*< loc2=nodplc(jcpt+loc2) >*/
loc2 = nodplc[tabinf_1.jcpt + loc2 - 1];
/*< go to 5 >*/
goto L5;
/* swap columns j1 and j2 */
/*< 80 loc1=nodplc(irpt+j1) >*/
L80:
loc1 = nodplc[tabinf_1.irpt + *j1 - 1];
/*< loc2=nodplc(irpt+j2) >*/
loc2 = nodplc[tabinf_1.irpt + *j2 - 1];
/*< nodplc(irpt+j1)=loc2 >*/
nodplc[tabinf_1.irpt + *j1 - 1] = loc2;
/*< nodplc(irpt+j2)=loc1 >*/
nodplc[tabinf_1.irpt + *j2 - 1] = loc1;
/* check for end of column */
/*< 85 if (loc1.le.0.and.loc2.le.0) go to 160 >*/
L85:
if (loc1 <= 0 && loc2 <= 0) {
goto L160;
}
/* check swap type */
/*< if (loc1.eq.0) go to 100 >*/
if (loc1 == 0) {
goto L100;
}
/*< if (loc2.eq.0) go to 90 >*/
if (loc2 == 0) {
goto L90;
}
/*< if (nodplc(irowno+loc1)-nodplc(irowno+loc2)) 90,95,100 >*/
if ((i_1 = nodplc[tabinf_1.irowno + loc1 - 1] - nodplc[tabinf_1.irowno +
loc2 - 1]) < 0) {
goto L90;
} else if (i_1 == 0) {
goto L95;
} else {
goto L100;
}
/*< 90 ktype=-1 >*/
L90:
ktype = -1;
/*< i=nodplc(irowno+loc1) >*/
i = nodplc[tabinf_1.irowno + loc1 - 1];
/*< go to 105 >*/
goto L105;
/*< 95 ktype=0 >*/
L95:
ktype = 0;
/*< i=nodplc(irowno+loc1) >*/
i = nodplc[tabinf_1.irowno + loc1 - 1];
/*< go to 105 >*/
goto L105;
/*< 100 ktype=1 >*/
L100:
ktype = 1;
/*< i=nodplc(irowno+loc2) >*/
i = nodplc[tabinf_1.irowno + loc2 - 1];
/* find pointer to entry (i,j1) */
/*< 105 loc=i >*/
L105:
loc = i;
/*< 110 lsav1=loc >*/
L110:
lsav1 = loc;
/*< loc=nodplc(jcpt+loc) >*/
loc = nodplc[tabinf_1.jcpt + loc - 1];
/*< if (loc.eq.0) go to 120 >*/
if (loc == 0) {
goto L120;
}
/*< if ((nodplc(jcolno+loc)-j1).lt.0) go to 110 >*/
if (nodplc[tabinf_1.jcolno + loc - 1] - *j1 < 0) {
goto L110;
}
/* find pointer to entry (i,j2) */
/*< 120 loc=i >*/
L120:
loc = i;
/*< 125 lsav2=loc >*/
L125:
lsav2 = loc;
/*< loc=nodplc(jcpt+loc) >*/
loc = nodplc[tabinf_1.jcpt + loc - 1];
/*< if(loc.eq.0) go to 135 >*/
if (loc == 0) {
goto L135;
}
/*< if ((nodplc(jcolno+loc)-j2).lt.0) go to 125 >*/
if (nodplc[tabinf_1.jcolno + loc - 1] - *j2 < 0) {
goto L125;
}
/* branch for row i in col j1, in both col"s j1 and j2, or in col j2
*/
/*< 135 if (ktype) 140,150,155 >*/
L135:
if (ktype < 0) {
goto L140;
} else if (ktype == 0) {
goto L150;
} else {
goto L155;
}
/* entry (i,j1) */
/*< 140 if (lsav1.eq.lsav2) go to 145 >*/
L140:
if (lsav1 == lsav2) {
goto L145;
}
/*< loc=nodplc(jcpt+lsav2) >*/
loc = nodplc[tabinf_1.jcpt + lsav2 - 1];
/*< nodplc(jcpt+lsav2)=loc1 >*/
nodplc[tabinf_1.jcpt + lsav2 - 1] = loc1;
/*< nodplc(jcpt+lsav1)=nodplc(jcpt+loc1) >*/
nodplc[tabinf_1.jcpt + lsav1 - 1] = nodplc[tabinf_1.jcpt + loc1 - 1];
/*< nodplc(jcpt+loc1)=loc >*/
nodplc[tabinf_1.jcpt + loc1 - 1] = loc;
/*< 145 nodplc(jcolno+loc1)=j2 >*/
L145:
nodplc[tabinf_1.jcolno + loc1 - 1] = *j2;
/*< loc1=nodplc(irpt+loc1) >*/
loc1 = nodplc[tabinf_1.irpt + loc1 - 1];
/*< go to 85 >*/
goto L85;
/* entries (i1,j) and (i2,j) */
/*< 150 nodplc(jcpt+lsav1)=loc2 >*/
L150:
nodplc[tabinf_1.jcpt + lsav1 - 1] = loc2;
/*< nodplc(jcpt+lsav2)=loc1 >*/
nodplc[tabinf_1.jcpt + lsav2 - 1] = loc1;
/*< loc=nodplc(jcpt+loc1) >*/
loc = nodplc[tabinf_1.jcpt + loc1 - 1];
/*< nodplc(jcpt+loc1)=nodplc(jcpt+loc2) >*/
nodplc[tabinf_1.jcpt + loc1 - 1] = nodplc[tabinf_1.jcpt + loc2 - 1];
/*< nodplc(jcpt+loc2)=loc >*/
nodplc[tabinf_1.jcpt + loc2 - 1] = loc;
/*< nodplc(jcolno+loc1)=j2 >*/
nodplc[tabinf_1.jcolno + loc1 - 1] = *j2;
/*< nodplc(jcolno+loc2)=j1 >*/
nodplc[tabinf_1.jcolno + loc2 - 1] = *j1;
/*< loc1=nodplc(irpt+loc1) >*/
loc1 = nodplc[tabinf_1.irpt + loc1 - 1];
/*< loc2=nodplc(irpt+loc2) >*/
loc2 = nodplc[tabinf_1.irpt + loc2 - 1];
/*< go to 85 >*/
goto L85;
/* entry (i,j2) */
/*< 155 if (lsav1.eq.lsav2) go to 158 >*/
L155:
if (lsav1 == lsav2) {
goto L158;
}
/*< loc=nodplc(jcpt+lsav1) >*/
loc = nodplc[tabinf_1.jcpt + lsav1 - 1];
/*< nodplc(jcpt+lsav1)=loc2 >*/
nodplc[tabinf_1.jcpt + lsav1 - 1] = loc2;
/*< nodplc(jcpt+lsav2)=nodplc(jcpt+loc2) >*/
nodplc[tabinf_1.jcpt + lsav2 - 1] = nodplc[tabinf_1.jcpt + loc2 - 1];
/*< nodplc(jcpt+loc2)=loc >*/
nodplc[tabinf_1.jcpt + loc2 - 1] = loc;
/*< 158 nodplc(jcolno+loc2)=j1 >*/
L158:
nodplc[tabinf_1.jcolno + loc2 - 1] = *j1;
/*< loc2=nodplc(irpt+loc2) >*/
loc2 = nodplc[tabinf_1.irpt + loc2 - 1];
/*< go to 85 >*/
goto L85;
/*< 160 return >*/
L160:
return 0;
/*< end >*/
} /* swapij_ */
#undef cvalue
#undef nodplc